#load "unix.cma";;
#load "graphics.cma";;
#load "bplib.cma";;
#load "bebop.cma";;
#load "bplib.cma";;

open Bplib
open Message 
open ListMap
open Inputtools
open Circuit
open Cdsmaker
open Inputmaker
open Vlogtools

;;

(* Test struct subst *)

let t = SubstMap.empty ;;

let addlist = 
  let rec aux accu = function
    | [] -> accu
    | (i, t)::q -> aux (IntMap.add i {subst_name = t} accu) q
  in aux;;

let i = addlist IntMap.empty [(3, "toto"); (5, "titi")];;

let f = StringMap.add "fox" i SubstMap.empty;;

SubstMap.find_dim "fx" f;;


let net_list filename =
  index_ligne_net_list := 1;
  let ic = open_in filename in
  let buff = Lexing.from_channel ic in
  let youpi = ParserNet.net_list LexerNet.lexem_list buff
  in
  begin
    message#read_net_list filename;
    close_in ic;
    youpi
  end;;

let _, _, _, _, dl, main = net_list "debug.bop";; 
List.hd dl;;


(* TEST DU TRI TOPO *)

let a, b = TriTopoGeneriqueFonction.tri_topo dl;;
List.iter (fun (u, v) -> print_endline u) a;;
List.map (fun (u, v) -> v) a;;

let test filename = 
  index_ligne_net_list := 1;
  let init = arite_primitive_initiale () in
  analyse_net_list init filename;;




(* TEST SUR BOP2VLOG *)

let prim_comp, t_analyse = test "montre.bop";;
let elt n = 
  let rec aux i = function
    | t::q -> if i = n then t else aux (succ i) q
    | _ -> raise Not_found
  in aux 0;;

elt 1 t_analyse.y_fcts_debouclees;;

let mem = memory_arite_of_export_memoire t_analyse.y_table_export_memoires;;

let mux = List.hd t_analyse.y_fcts_debouclees;;
let bloc = List.hd (List.tl t_analyse.y_fcts_debouclees);;
let corps = mux.corps_dcl_f;;
let corps_bloc = bloc.corps_dcl_f;;

let rom = elt 1 corps_bloc;;

let (interface_entree, interface_sortie, wire, substitution) =
  interfaces_wire_and_substitution_of_fonction_debouclee bloc;;

substitution [Vecteur (6, "d1", [Intervalle (0, 3)])];;
substitution [Vecteur (6, "d1", [Index 4])];;
substitution [Simple "c"];;

substitution [Vecteur (6, "s", [Intervalle (4, 0)])];;
substitution [Vecteur (6, "s", [Intervalle (0, 4)])];;

let vlog_substitution = substitution;;

let expand, indexation = mono_dim_vector_list "d1" [Intervalle (0, 4)];;

let arite_prim = prim_comp;; 
let fresh_node, _ = fresh_fct_factory (Printf.sprintf "node%d");;
let synchronize_module () = ();;

(* DEBUGGING *)

let env = ref StringMap.empty;;
let fct_d = ref t_analyse.y_fcts_debouclees;;

(* LOOP *)

let fd = List.hd !fct_d;;
let verilog_name = string_map (function | '[' | ']' -> '_' | o -> o) fd.nom_dcl_f;;
let moduleV = creer_verilog_module prim_comp mem !env fd verilog_name;;

fct_d := List.tl !fct_d;;
env := StringMap.add verilog_name moduleV !env;;


(* END LOOP *)


(* Debug C24 *)
(* LOOP *)
let n = ref (-1);;

let (interface_entree, interface_sortie, wire, substitution) =
  interfaces_wire_and_substitution_of_fonction_debouclee fd;;

(* LOOP *)

incr(n);; 
let mynode = elt !n fd.corps_dcl_f;;
let line, portee_call, (_, entrees_noeud_decorees), (_, sorties_noeud_decorees) = mynode;;

let vlog_sign_input = substitution entrees_noeud_decorees;;
let vlog_sign_output = substitution sorties_noeud_decorees;;

let name = match portee_call with LocalCall n -> n;;
StringMap.find name prim_comp;;

(* IF NOT FOUND : *)

let call_name = string_map  (function | '[' | ']' -> '_' | o -> o) name;;
let infos_vlog = StringMap.find call_name !env;;
let input_interface_expected = infos_vlog.vlog_entete.vlog_i_input
and output_interface_expected = infos_vlog.vlog_entete.vlog_i_output;;

let input_sign_received, output_sign_received =
  if infos_vlog.synchrone 
  then ((vlog_sign_input@[SIGNAL "clock"], vlog_sign_output))
  else (vlog_sign_input, vlog_sign_output)
;;

input_interface_expected;;
input_sign_received;;

output_interface_expected;;
output_sign_received;;


let input_relook = relook_vlog_signal_list input_interface_expected input_sign_received ;;

let output_relook = relook_vlog_signal_list output_interface_expected output_sign_received;;



(* END LOOP *)




let moduleMux = creer_verilog_module prim_comp mem env mux "mux_5_";;
let env1 = StringMap.add "MUX_5_" moduleMux env;;
let moduleBloc = creer_verilog_module prim_comp env1 bloc "bloc";;

moduleMux.vlog_entete.vlog_i_input;;
moduleMux.vlog_entete.vlog_i_output;;

let mynode = List.hd corps_bloc;;
let mynode = rom;;
let line, portee_call, (_, entrees_noeud_decorees), (_, sorties_noeud_decorees) = mynode;;
let vlog_sign_input = substitution entrees_noeud_decorees;;
let vlog_sign_output = substitution sorties_noeud_decorees;;
let name = match portee_call with LocalCall n -> n;;
StringMap.find name prim_comp;;



(* DANS LE CAS D'UNE MEMOIRE *)


StringMap.find "rom_C24" prim_comp;;
let (ad, wl) = try List.assoc "C24" mem with Not_found -> failwith "memory arite vlogtools" ;;

let input_interface_expected = [ BUS ("addr", (0, (pred ad))); WIRE "clock" ] 
and output_interface_expected = [ BUS ("word", (0, (pred wl))) ] ;;

input_interface_expected;;
(vlog_sign_input@[SIGNAL "clock"]);;


Count.interface_signal_list input_interface_expected;;
Count.call_signal_list (vlog_sign_input@[SIGNAL "clock"]);;

output_interface_expected;;
vlog_sign_output;;

Count.interface_signal_list output_interface_expected;;
Count.call_signal_list (vlog_sign_output);;

let input_relook = relook_vlog_signal_list input_interface_expected (vlog_sign_input@[SIGNAL "clock"]);;
let output_relook = relook_vlog_signal_list output_interface_expected vlog_sign_output;;


(BUS ("name", (0+3


let call_name = string_map  (function | '[' | ']' -> '_' | o -> o) "MUX[5]";;
let infos_vlog = StringMap.find call_name env1;;
let input_interface_expected = infos_vlog.vlog_entete.vlog_i_input
and output_interface_expected = infos_vlog.vlog_entete.vlog_i_output;;

let output_relook = relook_vlog_signal_list output_interface_expected vlog_sign_output;;
let input_relook = relook_vlog_signal_list input_interface_expected vlog_sign_input ;;

  let vlog_instances = 
    let vlog_instance_of_bebop_noeud_lineaire = function
      | line, portee_call, (_, entrees_noeud_decorees ), (_, sorties_noeud_decorees) ->
	  (* Substitution des variables vers leur representants verilog *)
	  let vlog_sign_input = vlog_substitution entrees_noeud_decorees 
	  and vlog_sign_output = vlog_substitution sorties_noeud_decorees in
	  begin
	    (* maintenant, il faut faire la difference selon la nature de portee_call *)
	    match portee_call with
	    | ExternalCall (appel, _, _, _) | PipeCall (appel, _) -> 
		Message.message#bloc_extern_for_compilation "bop2vlog" line appel;
		failwith "w-friendly"
	    | LocalCall loccall ->
		begin
		  (* En gros, faut savoir si c'est une primitive, une fonction, etc ... *)
		  (* le cas echeant, il faut recuperer ces infos dans l'environnement *)
		  (* voir la parente avec creer_fonction dans cdsmaker.ml *)
		  try
		    let infos_primitive = StringMap.find loccall arite_prim in
		    match fst infos_primitive with
		      
		    (* 0) garde de type par construction *)
		    | Input | Output | Regt | Regr _ -> failwith "garde de type construction vlogtools"
			
		    (* 1) Non supportes par la compilation *)
		    | PipeNode (appel, _, _)  
                    | ExternalNode (_, _, appel, _, _, _, _) -> 
			Message.message#bloc_extern_for_compilation "bop2vlog" line appel;
			failwith "w-friendly"

		    (* 2) Primitives bebop *)
		    | Mux -> INSTCALL ("bebop_mux", fresh_node (),  vlog_sign_output, vlog_sign_input)
			
		    (* registres : il faut ajouter l'horloge : du coup, la fonction elle-meme devient synchrone *)
		    | Reg ->
			begin
			  synchronize_module ();
			  INSTCALL ("bebop_reg", fresh_node (), vlog_sign_output, vlog_sign_input@[SIGNAL "clock"])
			end
		    | NReg -> failwith "TODO NREG in bop2vlog"

		    (* 3) Memoires : il faut aussi ajouter l'horloge *)
		    | Rom (name, _) -> 
			begin
			  synchronize_module ();
			  INSTCALL (Printf.sprintf "rom_%s" name, fresh_node (), vlog_sign_output, vlog_sign_input@[SIGNAL "clock"])
			end
		    | Ram (name, _) ->  
			begin
			  synchronize_module ();
			  INSTCALL (Printf.sprintf "ram_%s" name, fresh_node (), vlog_sign_output, vlog_sign_input@[SIGNAL "clock"])
			end

		    (* 4) Autres : compatibilite *)

		    (* assigns *)
		    | Id ->
			(* let count = Count.call_signal_list vlog_sign_output in *)
			let sig_in = CONCAT vlog_sign_input 
			and sig_out = CONCAT vlog_sign_output
			in
			ASSIGN (sig_out, ID sig_in)
 
		    | Gnd ->
			begin
			  let count = Count.call_signal_list vlog_sign_output in
			  match vlog_sign_output with
			  | [t] -> ASSIGN(t, GND count) 
			  | o -> ASSIGN (CONCAT vlog_sign_output, GND count)
			end
		    | Vdd   
		    | Clock ->
			begin
			  let count = Count.call_signal_list vlog_sign_output in
			  match vlog_sign_output with
			  | [t] -> ASSIGN(t, VDD count) 
			  | o -> ASSIGN (CONCAT vlog_sign_output, VDD count)
			end
                  
		    (* primitives de base *)
		    | Not -> INSTCALL ("not", fresh_node (), vlog_sign_output, vlog_sign_input)
		    | Et  -> INSTCALL ("and", fresh_node (), vlog_sign_output, vlog_sign_input)
		    | Ou  -> INSTCALL ("or", fresh_node (), vlog_sign_output, vlog_sign_input)
		    | Xor -> INSTCALL ("xor", fresh_node (), vlog_sign_output, vlog_sign_input)

		  (* SINON *)
		  with
		    (* ce n'est pas une primitive *)
		  | Not_found ->
		      (* on remplace le nom avec la convention de nommage pour le developpement des fonctions a parametres *) 
		      let call_name = string_map (function | '[' | ']' -> '_' | o -> o) loccall in
		      begin 
			(* Alors, on essaye de voir si c'est un appel a une fonction de l'environnement *)
			try
			  let infos_vlog = StringMap.find call_name env in
			  (* On va pouvoir trouver les interfaces attendues par cette fonction *)
			  (* notamment savoir s'il faut ajouter l'horloge pour partage *)
			  let input_interface_expected = infos_vlog.vlog_entete.vlog_i_input
			  and output_interface_expected = infos_vlog.vlog_entete.vlog_i_output in
			  (* on va faire un relooking des variables decorees apres substitution *)
			  let output_relook = relook_vlog_signal_list output_interface_expected vlog_sign_output
			  and input_relook = relook_vlog_signal_list input_interface_expected vlog_sign_input in
			  INSTCALL (call_name, fresh_node (), output_relook, input_relook)
			with
			  (* sinon, c'est une fonction indefinie, impossible d'apres les verifications Context *)
			| Not_found -> failwith "Qui ne fait pas un bon job dans vlogtools ?"
		      end

		end
	  end
    in
    List.map vlog_instance_of_bebop_noeud_lineaire corps;;



;;























let mega_test filename = 
  let mem, (env, main) = test filename in
  let (fresh_name, _ ) = fresh_fct_factory transf_fresh_inline in
  creer_pre_graphe fresh_name main env;;



let comp, fct_d = test "montre.bop";;
StringMap.iter (fun a _ -> print_endline a) comp;;
let fct_ds = fct_d.y_fcts_debouclees;;

let elt n = 
  let rec aux i = function
    | t::q -> if i = n then t else aux (succ i) q
    | _ -> raise Not_found
  in aux 0;;

let b =  elt 6 fct_ds;; 
b.corps_dcl_f;;
b.entrees_dcl_f;;
b.sorties_dcl_f;;
cd;;
cb;;
let t = fct_d.y_table_export_memoires;;
t.(2);;


let comp, fct_d = test "debug.bop";;
StringMap.iter (fun a _ -> print_endline a) comp;;
let fct_ds = fct_d.y_fcts_debouclees;;
fct_ds;;
fct_d.y_default_main;;



let m, (env, main_name) = test "search_bop2c/mem.bop";;
let main = ListMap.StringMap.find "main" env;;
let mt = mega_test "search_bop2c/mem.bop";;
 
let cds_brut = cds_brut_of_pre_graphe mt;;
let cds_final = let sr = split_registers cds_brut in
begin
  tri_topo sr;
  sr
end;;


let m, bloc_ext, (env, main) = test "montre.bop";;


let r1 = test "net_list_pipe.bop";;

let show_liaisons = 
  let change = ref "" in
  let f_iter name (i,j) =
    if name <> !change 
    then 
      begin
	Printf.fprintf stdout "\n%s" name;
	change := name;
      end
    else ();
    Printf.fprintf stdout " (%d,%d)" i j; flush stdout
  in StringListMap.iter f_iter;;


let pg = mega_test "net_list_pipe.bop";;

show_liaisons pg.liaisons;;

let pg = mega_test "meta_script/net_list_m.c";;

let count_porte f tab = 
  let c = ref 0 in
  for i = 0 to pred (Array.length tab) do
    if f tab.(i) then incr c else ()
  done;
  !c;;

let f = function | e, _, _ -> e = Reg;;
count_porte f pg.portes;;

show_liaisons pg.liaisons;;

pg.portes.(8);;
pg.portes.(151);;


ListMap.iter pg.liaisons
(* let mac, mem, fct = net_list "parametrees";; *)
let mem, (env, main) = test "parametrees";;
mega_test "parametrees";;


StringMap.iter (fun i _ -> Printf.fprintf stdout "%s\n" i) env;;
StringMap.find "CM2[1]" env;;
StringMap.find "C24" env;;
Array.length m.(1);;
StringMap.find "Montre" env;;


Inputtools.index_ligne_net_list;;
let ic = open_in "parametrees";;
let buff = Lexing.from_channel ic;;
Lexing.lexeme buff;;


let mac, mem, fct = net_list_of_file "exemple_syntaxe_concraite.c";;
let m, e, d = couple_of_input_file "super_input.c";;
let m, e, d = verb "../input";;
Inputtools.index_ligne_input_file;;

let mac = env_macros_of_macros_decl "Input" m;;
expand_net_var_list "Input" mac e;; 

let filename = "montre.bop";;

let primitive_initiale = arite_primitive_initiale ();;
let rom_memory_tab, ext, (env, axiome) = 
  memory_and_env_of_file primitive_initiale filename;;


let net = net_list_of_file filename;;
 let memory, table_arite_completee =  match net_list_of_file filename with
  | mems_decl, fcts_decl ->  
	add_ram_rom_in_primitive mems_decl primitive_initiale ;;
 
let fcts_delc = match net with _, t -> t;;

StringMap.iter (fun n (_,(_,_)) -> print_endline n) table_arite_completee;;


let (fresh_name, _ ) = fresh_fct_factory transf_fresh_inline;;

let pre_graphe =  creer_pre_graphe fresh_name axiome env ;;


let portes = pre_graphe.portes;;
StringListMap.find "$3$" pre_graphe.liaisons;;


in


  let cds_brut = cds_brut_of_pre_graphe pre_graphe in
  let cds_final = split_registers cds_brut in
  begin
    tri_topo cds_final; 
    let des_main = StringMap.find axiome env in
    begin
      message#creation_objet;
      new circuit cds_final rom_memory_tab 
        des_main.entrees_formelles 
	des_main.sorties_formelles
    end
  end

;;

#load "unix.cma";;
#load "graphics.cma";;
#load "bebop.cma";;


open Message 
open ListMap
open Inputtools
open Circuit
open Cdsmaker
open Inputmaker
;;


let c = circuit_final_of_net_list "montre.bop";;

c#init;;

let cds = c#get_cds;;


c#get_entree;;
c#get_sortie;;

Array.length cds;;

let coupe cds = Array.init 16 (fun i -> 
			    if i <> 15 
			    then Array.init 10 (fun j -> cds.(10 * i + j))
			    else Array.init 14 (fun j -> cds.(10 * i + j))
			 );; 

coupe.(0);;
coupe.(1);;
coupe.(2);;
coupe.(3);;

coupe.(5).(6);;


(* on ecrit ici l'optimisateur *)
type entree_taguee = TagInit | Invariante | Pointee of (int*  int);;
type noeud_tague = 
    {
      mutable delete : bool;
      infos_node : noeud;
      entrees_taguee : entree_taguee array;
    }

let noeud_tague_of_noeud n =
  {
    delete = false;
    infos_node = n;
    entrees_taguee = Array.make (Array.length n.entree) TagInit;
  }
    
let cds_optimise_of_cds cds =
  let len = Array.length cds in
  let cds_tag = Array.map noeud_tague_of_noeud cds in 
  let finish () = cds_tag
  in
  let assign_invariant value (v, index) =
    begin
      cds_tag.(v).infos_node.entree.(index) <- value;
      cds_tag.(v).entrees_taguee.(index) <- Invariante
    end
  in
  let assign_pointee (v, index) (a, b) = cds_tag.(a).entrees_taguee.(b) <- Pointee (v, index)
  in
  let rec parcours i =
    if ( i >= len ) 
    then finish ()
    else
      begin
	begin
	  (* Les cas qui nous interresse : Gnd, Vdd, Id *)
	  match cds_tag.(i).infos_node.noeud_type with
	  | Gnd ->
	      begin
		List.iter (assign_invariant false) cds_tag.(i).infos_node.voisins.(0);
		cds_tag.(i).delete <- true
	      end
	  | Vdd | Clock ->
	      begin
		List.iter (assign_invariant true) cds_tag.(i).infos_node.voisins.(0);
		cds_tag.(i).delete <- true
	      end
	  | Id ->
	      begin
		match cds_tag.(i).entrees_taguee.(0) with
		| TagInit -> failwith (Printf.sprintf "Gate : %d : id sans parent" i)
		| Invariante ->
		    begin
		      (* issu d'une opt ci-dessus par exemple *)
		      let value = cds_tag.(i).infos_node.entree.(0) in
		      List.iter (assign_invariant value) cds_tag.(i).infos_node.voisins.(0);
		      cds_tag.(i).delete <- true
		    end
		| Pointee (v, index) ->
		    begin
		      (* il faut enlever le pointeur vers ici dans v et ajouter ses voisins *)
		      (* par conditions de contexte, les listes sont disjointes *)
		      let filter (a, b) = (a <> i) || (b <> 0) in
		      let removed_this = List.filter filter cds_tag.(v).infos_node.voisins.(index) in
		      cds_tag.(v).infos_node.voisins.(index) <- removed_this@cds_tag.(i).infos_node.voisins.(0);
		      (* Propager l'information Pointee sur les nouveaux voisins *)
		      List.iter (assign_pointee (v, index)) cds_tag.(i).infos_node.voisins.(0);
		      cds_tag.(i).delete <- true
		    end 
	      end 
	  | _ ->
	      begin
		(* TODO : application partielle, et propagation de l'invariance *)
		Array.iteri (fun j voisins -> List.iter (assign_pointee (i, j)) voisins) cds_tag.(i).infos_node.voisins
	      end
	end;
	parcours (succ i)
      end
  in parcours 0;; 


cds;;
let cds_tag = cds_optimise_of_cds cds;;
Array.length cds_tag;;


count_remove cds_tag;;

let coupe0 = coupe cds_tag;; 
coupe0.(3);;
coupe0.(4);;
coupe0.(5);;
coupe0.(6);;
coupe0.(7);;
coupe0.(8);;
coupe0.(9);;
coupe0.(10);;
coupe0.(11);;
coupe0.(12);;
coupe0.(13);;
coupe0.(14);;
coupe0.(15).(14);;

;;
(*
{delete = true;
 infos_node =
  {entree = [|true|]; sortie = [|false|]; voisins = [|[(154, 1); (121, 1)]|];
   noeud_type = Id};
 entrees_taguee = [|Invariante|]}
# 
*)

coupe0.(12).(1);;
coupe0.(15).(4);;

coupe0.(12).(0);;
coupe0.(5).(5);;
coupe0.(9).(1);;
coupe0.(14).(1);;
coupe0.(3).(6);;

  infos_node =
    {entree = [|false|]; sortie = [|false|];
     voisins = [|[(47, 1); (38, 1)]|]; noeud_type = Id};
   entrees_taguee = [|Pointee (36, 0)|]};

;;
      
let count_remove cds_t = 
  let len = Array.length cds_t in
  let count = ref 0 in
  for i = 0 to pred len do
    if cds_t.(i).delete then incr(count) else ()
  done;
  !count
	  
let array_exists fct a =
  let len = Array.length a in
  let rec aux i = 
    if i >= len then false
    else if fct a.(i) then true else aux (succ i)
  in aux 0;;

let search_parent cds i = 
  let len = Array.length cds in
  let rec aux accu j =
    if j >= len then List.rev accu 
    else
      let exists (a, b) = a = i in
      if array_exists (List.exists exists) cds.(j).voisins 
      then aux (j::accu) (succ j) else aux accu (succ j)
  in aux [] 0;;

let search_type cds t = 
  let len = Array.length cds in
  let rec aux accu j =
    if j >= len then List.rev accu 
    else
      if cds.(j).noeud_type = t 
      then aux (j::accu) (succ j) else aux accu (succ j)
  in aux [] 0;;
	
	
let les_id = search_type cds Id;;
cds.(37);;
search_parent cds 123;;
coupe0.(12);;




let s = c#tableprocess.(0);;

Printf.fprintf s.entreepipe "0\n";;
flush s.entreepipe;;


for i = 0 to 5 do
  Printf.fprintf s.entreepipe "1\n";
  flush s.entreepipe;
  print_endline (input_line s.sortiepipe)
done;;


string_of_bits c#get_cds.(1).entree;;
c#externalprocess;;

let v t = t.(0) <- Random.bool ();;

c#un_cycle v;;
c#get_sortie;;

c#quit;;
